Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE23/EXPRESS/SOURCE/EXPEDITR.PAS

Pascal/Delphi Source File | 1997-02-24 | 10.2 KB | 355 lines

unit ExpEditr;

interface

uses SysUtils, WinTypes, WinProcs, Classes, Graphics, Forms, Controls,
  Dialogs, Buttons, StdCtrls, ExtCtrls, Grids, DsgnIntf, ExpComp;

type
  { TNamedExpressionsProperty definition }

  TNamedExpressionsProperty = class(TPropertyEditor)
  public
    function   GetAttributes: TPropertyAttributes; override;
    function   GetValue: string; override;
    procedure  Edit; override;
  end;

  { TfrmExpressionEditor definition }

  TfrmExpressionEditor = class(TForm)
    StrGrdNamedExpressions: TStringGrid;
    bvlBevel: TBevel;
    hdrNamedExpressions: THeader;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    btnSave: TButton;
    btnLoad: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    edtSource: TEdit;
    btnClear: TButton;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormActivate(Sender: TObject);
    procedure btnLoadClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure StrGrdNamedExpressionsSelectCell(Sender: TObject; Col,
      Row: Longint; var CanSelect: Boolean);
  private
    { Private declarations }
    FRow: Integer;
  public
    { Public declarations }
    function  Execute: Boolean;
    procedure LoadFromFile(FileToLoad: string);
    procedure AddNamedExpression(ExpName, Expression: string);
    function  GetRowCount: Integer;
    function  GetExpressionNameAt(Idx: Integer): string;
    function  GetExpressionAt(Idx: Integer): string;
  end;

procedure Register;

var
  NamedExpStringList: TStringList;

implementation

{$R *.DFM}

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(TStrings),
                         TExpression,
                         'NamedExpressions',
                         TNamedExpressionsProperty);
end;

{  TNamedExpressionsProperty declarations  }

function TNamedExpressionsProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

function TNamedExpressionsProperty.GetValue: string;
begin
  Result := Format('(%s)', [GetPropType^.Name]);
end;

procedure TNamedExpressionsProperty.Edit;
var
  frmExpressionEditor: TfrmExpressionEditor;
  ExpCount: Integer;
  Name, Expression: string;
begin
  NamedExpStringList := TStringList(TExpression(GetComponent(0)).NamedExpressions);

  frmExpressionEditor := TfrmExpressionEditor.Create(Application);

  try
    if (NamedExpStringList.Count = 1) then
        begin
          frmExpressionEditor.LoadFromFile(NamedExpStringList[0]);
          frmExpressionEditor.edtSource.Text := ExpandFileName(NamedExpStringList[0]);
        end
    else
        if (NamedExpStringList.Count > 0) then
            begin
              if (NamedExpStringList.Count / 2) > 19 then
                  frmExpressionEditor.strgrdNamedExpressions.RowCount :=  Round(NamedExpStringList.Count / 2) + 10;

              with NamedExpStringList do
                 for ExpCount := 0 to Count - 1 do
                     if Odd(ExpCount + 1) then
                        Name := Strings[ExpCount]
                     else
                        begin
                          Expression := Strings[ExpCount];
                          frmExpressionEditor.AddNamedExpression(Name, Expression);
                        end;
            end;

    if frmExpressionEditor.Execute then
       if frmExpressionEditor.ModalResult = mrOK then
          begin
            NamedExpStringList.Clear;

            if frmExpressionEditor.edtSource.Text <> '' then
               NamedExpStringList.Add(ExtractFileName(frmExpressionEditor.edtSource.Text))
            else
               if (frmExpressionEditor.GetRowCount > 0) then
                   for ExpCount := 0 to frmExpressionEditor.GetRowCount - 1 do
                      begin
                        NamedExpStringList.Add(UpperCase(frmExpressionEditor.GetExpressionNameAt(ExpCount)));
                        NamedExpStringList.Add(frmExpressionEditor.GetExpressionAt(ExpCount));
                      end;
          end;
  finally
    frmExpressionEditor.Free;
  end;
end;

{  TfrmExpressionEditor declarations  }

function TfrmExpressionEditor.Execute: Boolean;
begin
  Result := False;

  if (Self <> nil) then
      begin
        ShowModal;

        if (ModalResult = mrOk) then
            Result := True;
      end;
end;

procedure TfrmExpressionEditor.LoadFromFile(FileToLoad: string);
var
  TempStringList: TStringList;
  ExpCount: Integer;
  Name: string;
  Exp: string;
begin
  TempStringList := TStringList.Create;

  try
    strgrdNamedExpressions.Enabled := False;

    FRow := 0;

    TempStringList.LoadFromFile(FileToLoad);

    if (TempStringList.Count > 19) then
        strgrdNamedExpressions.RowCount := TempStringList.Count + 10;

    for ExpCount := 0 to TempStringList.Count - 1 do
       begin
         Name := Copy(TempStringList[ExpCount], 1, Pos('=', TempStringList[ExpCount]) - 1);
         Exp  := Copy(TempStringList[ExpCount], Pos('=', TempStringList[ExpCount]) + 1, 255);

         AddNamedExpression(Name, Exp);
       end;
  finally
    strgrdNamedExpressions.Enabled := True;
    TempStringList.Free;
  end;
end;

procedure TfrmExpressionEditor.AddNamedExpression(ExpName, Expression: string);
begin
  with strgrdNamedExpressions do
    begin
      Cells[0, FRow] := ExpName;
      Cells[1, FRow] := Expression;
    end;

  Inc(FRow);
end;

function TfrmExpressionEditor.GetRowCount: Integer;
begin
  Result := 0;

  repeat
    with strgrdNamedExpressions do
       if (Cells[0, Result] = '') and
          (Cells[1, Result] = '') then
           break;

    if (strgrdNamedExpressions.Cells[0, Result] = '') then
        begin
          with strgrdNamedExpressions do
            begin
              Col := 0;
              Row := Result;
              SetFocus;
            end;

          raise EStringListError.Create('Expression at row ' +
                                        IntToStr(Result + 1) +
                                        ' does not have a Name');
        end;

    if (strgrdNamedExpressions.Cells[1, Result] = '') then
        begin
          with strgrdNamedExpressions do
            begin
              Col := 1;
              Row := Result;
              SetFocus;
            end;

          raise EStringListError.Create('Expression is missing at row ' +
                                        IntToStr(Result + 1));
        end;

    Inc(Result);
  until (Result = strgrdNamedExpressions.RowCount);
end;

function TfrmExpressionEditor.GetExpressionNameAt(Idx: Integer): string;
begin
  Result := strgrdNamedExpressions.Cells[0, Idx];
end;

function TfrmExpressionEditor.GetExpressionAt(Idx: Integer): string;
begin
  Result := strgrdNamedExpressions.Cells[1, Idx];
end;

procedure TfrmExpressionEditor.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
var
  Idx: Integer;
  tmpExpression: TExpression;
begin
  case ModalResult of
     mrCancel: CanClose := True;

     mrOK: begin
             if (GetRowCount > 0) then
                 begin
                   tmpExpression := TExpression.Create(Self);

                   try
                     tmpExpression.SilentExceptions := True;

                     for Idx := 0 to GetRowCount - 1 do
                        begin
                          tmpExpression.Expression := GetExpressionAt(Idx);

                          if (not tmpExpression.ValidExpression) then
                              begin
                                with strgrdNamedExpressions do
                                   begin
                                     Col := 1;
                                     Row := Idx;
                                     SetFocus;
                                   end;

                                raise TExpressionException.Create('Expression at Row ' +
                                                                  IntToStr(Idx + 1) +
                                                                  ' is not a valid expression');
                              end;
                        end;
                   finally
                     tmpExpression.Free;
                   end;
                 end;
           end;
     else
           CanClose := False;
  end;
end;

procedure TfrmExpressionEditor.FormActivate(Sender: TObject);
begin
  FRow := 0;
end;

procedure TfrmExpressionEditor.btnLoadClick(Sender: TObject);
var
  TempStringList: TStringList;
begin
  btnSave.Font.Style := [];
  TButton(Sender).Font.Style := [fsBold];

  OpenDialog1.InitialDir := ExtractFilePath(edtSource.Text);
  OpenDialog1.FileName   := ExtractFileName(edtSource.Text);

  if OpenDialog1.Execute then
     begin
       edtSource.Text := OpenDialog1.FileName;
       LoadFromFile(OpenDialog1.FileName);
     end;
end;

procedure TfrmExpressionEditor.btnSaveClick(Sender: TObject);
var
  TempStringList: TStringList;
  ExpCount: Integer;
begin
  btnLoad.Font.Style := [];
  TButton(Sender).Font.Style := [fsBold];

  SaveDialog1.InitialDir := ExtractFilePath(edtSource.Text);
  SaveDialog1.FileName   := ExtractFileName(edtSource.Text);

  if SaveDialog1.Execute then
     if (GetRowCount > 0) then
         begin
           edtSource.Text := SaveDialog1.FileName;

           TempStringList := TStringList.Create;

           try
             for ExpCount := 0 to GetRowCount - 1 do
                 TempStringList.Add(GetExpressionNameAt(ExpCount) +
                                    '=' +
                                    GetExpressionAt(ExpCount));

             TempStringList.SaveToFile(SaveDialog1.FileName);
           finally
             TempStringList.Free;
           end;
         end;
end;

procedure TfrmExpressionEditor.btnClearClick(Sender: TObject);
begin
  edtSource.Text := '';
end;

procedure TfrmExpressionEditor.StrGrdNamedExpressionsSelectCell(
  Sender: TObject; Col, Row: Longint; var CanSelect: Boolean);
begin
  with strgrdNamedExpressions do
    if (Row = RowCount - 1) AND ((Cells[0, Row] <> '') OR (Cells[1, Row] <> '')) then
        RowCount := RowCount + 10;
end;

end.